Kit PC World De Ampliacion De Windows 95/Kit PC World de ampliacion de Windows 95.iso/clarion/3rdparty/tools/library/memo_prt.clw

Text File | 1995-10-23 | 7.0 KB | 209 lines

           MEMBER('TestMemo.clw')         ! This is a MEMBER module
MemoPrint          PROCEDURE

!!!!!! Prototype for API used:  SendMessage(USHORT,USHORT,USHORT,ULONG),ULONG,PASCAL

EM_GetLineCount      EQUATE(040Ah)
EM_GetLine           EQUATE(0414h)
memofield            STRING(10000)
memoline             STRING(255)
PrintDate            DATE

RejectRecord         LONG,AUTO
LocalRequest         LONG,AUTO
LocalResponse        LONG,AUTO
WindowOpened         LONG,AUTO
RecordsToProcess     LONG,AUTO
RecordsProcessed     LONG,AUTO
RecordsPerCycle      LONG,AUTO
RecordsThisCycle     LONG,AUTO
PercentProgress      DECIMAL(4,1)
RecordStatus         BYTE,AUTO
!-----------------------------------------------------------------------------
Report REPORT,AT(15,21,180,249),PRE(RPT),FONT('Arial',8,,FONT:regular),MM
       HEADER,AT(15,,180,21),FONT('Arial',10,,)
         STRING('Example of Memo Printing Report'),AT(8,0,129,),FONT('Arial',16,,FONT:bold),USE(?Header1), |
             TRN,LEFT
         STRING('Date:'),AT(8,10,10,4),FONT('Arial',10,,FONT:bold),USE(?Title1)
         STRING(@d5),AT(21,10,17,4),FONT('Arial',10,,FONT:regular),USE(PrintDate)
       END
detail DETAIL,AT(,,,10),FONT('Arial',10,,FONT:regular),USE(?detail)
         STRING(@n4),AT(8,4,10,4),FONT('Arial',10,,FONT:bold),USE(ite:number)
         STRING(@s35),AT(29,4,88,4),FONT('Arial',10,,FONT:regular),USE(ite:header)
       END
ldetail DETAIL,AT(,,,3),FONT('Arial',10,,),USE(?ldetail)
         TEXT,AT(40,0,170,),FONT('Arial',10,,FONT:regular),USE(?ite:description)
         STRING(@S255),AT(40,0,170,),FONT('Arial',10,,FONT:regular),USE(memoline)
       END
       FOOTER,AT(15,270,180,10),USE(?footer)
         STRING('Page:'),AT(10,2,,),FONT('Arial',10,,FONT:regular),USE(?Title9)
         STRING(@n2),AT(23,2,8,4),FONT('Arial',10,,FONT:regular),PAGENO,USE(?String26)
       END
     END

!!!! After Report Declaration Embed Point
window WINDOW('Window for text Measuring'),AT(3,24,394,51),STATUS,TIMER(1),SYSTEM,GRAY,MASK,MODAL
       TEXT,AT(10,5,195,38),FONT('Arial',8,,FONT:regular+FONT:italic),USE(memofield),HIDE
     END
!!!! End of Embed Point

ProgressWindow       WINDOW('Progress...'),AT(,,142,59),CENTER,TIMER(1),GRAY,DOUBLE
                       STRING(''),AT(0,3,141,10),USE(?Progress:UserString),CENTER
                       BOX,AT(15,15,111,12),COLOR(00H),FILL(0FFFFFFH)
                       BOX,AT(21,18,100,6),COLOR(00H),FILL(0C0C0C0H)
                       BOX,AT(21,18,100,6),USE(?Progress:Thermometer),FILL(0FFH)
                       STRING(''),AT(0,30,141,10),USE(?Progress:PctText),CENTER
                       BUTTON('Cancel'),AT(45,42,50,15),USE(?Progress:Cancel)
                     END
  CODE
  LocalRequest = GlobalRequest
  LocalResponse = RequestCancelled
  CLEAR(GlobalRequest)
  CLEAR(GlobalResponse)
  IF items::Used = 0
    CheckOpen(items,1)
  END
  items::Used += 1
  IF sysgen::Used = 0
    CheckOpen(sysgen,1)
  END
  sysgen::Used += 1

  PrintDate = TODAY()
  RecordsToProcess = RECORDS(items)
  RecordsPerCycle = 25
  RecordsProcessed = 0
  PercentProgress = 0
  CLEAR(ite:record)
  OPEN(ProgressWindow)
  ?Progress:Thermometer{Prop:Width} = 0
  ?Progress:PctText{Prop:Text} = '0.0% Completed'
  ProgressWindow{Prop:Text} = 'Printing Report'
  ?Progress:UserString{Prop:Text}=''
  ACCEPT
    CASE EVENT()
    OF Event:OpenWindow
      CLEAR(ite:record,-1)
      SET(ite:by_number,ite:by_number)
      LOOP
        DO GetNextitems
        DO ValidateRecord
        EXECUTE RecordStatus
          BEGIN
            LocalResponse = RequestCancelled
            BREAK
          END
          CYCLE
        END
        BREAK
      END
      IF LocalResponse = RequestCancelled
        POST(Event:CloseWindow)
        CYCLE
      END
      !!!! Before Opening Report Embed Point
      SET(sysgen)
      NEXT(sysgen)
      IF ERROR() THEN STOP(ERROR()).
      !!!! End of Embed
      OPEN(Report)
      !!!! After Opening Report Embed Point
      SETTARGET(report)
      !!!! End of Embed
    OF Event:Timer
      LOOP RecordsPerCycle TIMES
        PRINT(RPT:detail)
        !!!! After Printing Detail Section Embed Point
        Memofield = ite:description                         ! ite:description is the memo field
        OPEN(Window)
        window{prop:hide} = true
!        window$?memofield{prop:at,3} = sys:memowidth       !This sets the width which gets
                                                            !printed and is font dependent.
                                                            !If only one font is to be used then
                                                            !the appropriate width can be fixed
                                                            !in the window itself.
        handle# = window$?memofield{prop:handle}
        lines# = SendMessage(handle#,EM_GETLINECOUNT,0,0)
        LOOP I# = 0 TO LINES#-1
          len# = SendMessage(handle#,EM_GETLINE,I#,ADDRESS(memoline))
          memoline[len#+1] = CHR(0)
          PRINT(rpt:ldetail)
        END
        CLOSE(window)
        !!!! End of Embed Point
        LOOP
          DO GetNextRecord
          DO ValidateRecord
          EXECUTE RecordStatus
            BEGIN
              LocalResponse = RequestCancelled
              BREAK
            END
            CYCLE
          END
          BREAK
        END
        IF LocalResponse = RequestCancelled
          LocalResponse = RequestCompleted
          BREAK
        END
        LocalResponse = RequestCancelled
      END
      IF LocalResponse = RequestCompleted
        POST(Event:CloseWindow)
      END
    END
    CASE FIELD()
    OF ?Progress:Cancel
      CASE Event()
      OF Event:Accepted
        LocalResponse = RequestCancelled
        POST(Event:CloseWindow)
      END
    END
  END
  CLOSE(Report)
  DO ProcedureReturn
ProcedureReturn ROUTINE
  items::Used -= 1
  IF items::Used = 0 THEN CLOSE(items).
  sysgen::Used -= 1
  IF sysgen::Used = 0 THEN CLOSE(sysgen).
  IF LocalResponse
    GlobalResponse = LocalResponse
  ELSE
    GlobalResponse = RequestCancelled
  END
  RETURN
!-----------------------------------------------------------------------------
ValidateRecord       ROUTINE
  RecordStatus = Record:OutOfRange
  IF LocalResponse = RequestCancelled THEN EXIT.
  IF ERRORCODE() THEN EXIT.
  RecordStatus = Record:OK
  EXIT
GetNextitems ROUTINE
  LocalResponse = RequestCancelled
  LOOP
    NEXT(items)
    IF ERRORCODE() THEN EXIT.
    RecordsProcessed += 1
    RecordsThisCycle += 1
    IF PercentProgress < 100
      PercentProgress = (RecordsProcessed / RecordsToProcess)*100
      IF PercentProgress > 100
        PercentProgress = 100
      END
      ?Progress:Thermometer{Prop:Width} = ROUND(PercentProgress,0)
      ?Progress:PctText{Prop:Text} = FORMAT(PercentProgress,@N5.1) & '% Completed'
      DISPLAY()
    END
    BREAK
  END
  LocalResponse = RequestCompleted
  EXIT

GetNextRecord ROUTINE
  DO GetNextitems
  IF LocalResponse = RequestCompleted THEN EXIT.